 
VISTA2>P
R1FHQUE  ;REGION 1/KLD; 5/17/13; AUTO-QUEUE DIETETICS REPORTS & LABELS; 11/7/14  3:31 PM
         ;;1.0;R1FHQ;;;Build 8
         ;Run shortly after midnight
         ;Original version June 2004
ST       F R1I=0:0 S R1I=$O(^R1(100100.024,R1I)) Q:'R1I  D:$$GET1^DIQ(100100.024,R1I,5)="YES" ML
K        K %,DA,DIC,DIE,DIK,DR,R1,R1I,R1II,R1III,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("R1FHQUE",$J) Q
         ;
ML       ;Main loop
         S R1("FLAG")=0
         I $O(^R1(100100.024,R1I,2,0)) D  Q:'R1("FLAG")  ;Only run certain days of the week
         .S X=DT D DW^%DTC S Y=Y+1,R1("FLAG")=$D(^R1(100100.024,R1I,2,"B",Y))
         S R1("TIME")=$$GET1^DIQ(100100.024,R1I,1)
         S:R1("TIME")<600 R1("TIME")=0_R1("TIME")
         S %DT="R",X="T@"_R1("TIME") D ^%DT S ZTDTH=$S($D(R1("TEST")):$H,1:Y)
         S ZTDESC=$$GET1^DIQ(100100.024,R1I,.01)_" Auto Queue"
         S ZTIO=$$GET1^DIQ(100100.024,R1I,2)
         S ZTRTN=$$GET1^DIQ(100100.024,R1I,3)_U_$$GET1^DIQ(100100.024,R1I,4)
         F R1II=0:0 S R1II=$O(^R1(100100.024,R1I,1,R1II)) Q:'R1II  D  ;Get necessary variables
         .S R1("VAR")=$$GET1^DIQ(100100.0242,R1II_","_R1I,.01)
         .S @R1("VAR")=$TR($$GET1^DIQ(100100.0242,R1II_","_R1I,1),"|",U)
         .D:$$GET1^DIQ(100100.0242,R1II_","_R1I,2)="YES"  ;Date variable
         ..S X=$TR($$GET1^DIQ(100100.0242,R1II_","_R1I,1),"|",U),%DT=$S(X["@":"R",1:"")
         ..D ^%DT S @R1("VAR")=Y
         .S X=$TR($$GET1^DIQ(100100.0242,R1II_","_R1I,3),"|",U) X:X]"" X ;Xecutable code to set the variable
         .S ZTSAVE(R1("VAR"))=@R1("VAR")
         D ^%ZTLOAD W !!,"ZTSK=",$G(ZTSK) Q
         ;
TEST     ;Test one particular option
         R !!,"IEN: ",R1I:DTIME Q:U[R1I  S R1("TEST")=""
         I '$D(^R1(100100.0243,R1I)) W !,"Invalid IEN!" G TEST
         W ! S DIC="^%ZIS(1,",DIC(0)="QEAM",DIC("A")="Select printer: " D ^DIC
         G TEST:Y<1 S ZTIO=$P(Y,U,2) D ML,K Q
         ;
SRCH     ;Search file 19 for a synonym
         S:'$D(R1("STR")) R1("STR")="FH"
         R !!,"Search for: ",R1("SRCH"):DTIME Q:U[R1("SRCH")
         S R1I=R1("STR") F  S R1I=$O(^DIC(19,"B",R1I)) Q:$E(R1I,1,2)'=R1("STR")!(R1I="")  D
         .F R1II=0:0 S R1II=$O(^DIC(19,"B",R1I,R1II)) Q:'R1II  D
         ..F R1III=0:0 S R1III=$O(^DIC(19,R1II,10,R1III)) Q:'R1III  D
         ...S X=$$GET1^DIQ(19.01,R1III_","_R1II,2)
         ...W:X[R1("SRCH") !!,R1I,!?3,X,?17,$$GET1^DIQ(19.01,"25,2",.01)
         D K Q
         ;
UEDIT    ;User edit of options
         K ^TMP("R1FHQUE",$J) S R1("CNT")=0,R1I=""
         F  S R1I=$O(^R1(100100.0243,"B",R1I)) Q:R1I=""  D
         .F R1II=0:0 S R1II=$O(^R1(100100.0243,"B",R1I,R1II)) Q:'R1II  D
         ..S X=$$GET1^DIQ(100100.0243,R1II,.01) Q:X=""
         ..S X(1)=$$GET1^DIQ(100100.0243,R1II,1) S:X(1)="" X(1)="NULL"
         ..S ^TMP("R1FHQUE",$J,X,X(1))=$$GET1^DIQ(19,R1I,1)_U_R1II
         S (R1I,R1II)="" W !!,"Available options are:"
         F  S R1I=$O(^TMP("R1FHQUE",$J,R1I)) Q:R1I=""  D
         .F  S R1II=$O(^TMP("R1FHQUE",$J,R1I,R1II)) Q:R1II=""  D
         ..S R1("CNT")=R1("CNT")+1,R1("SEL",R1("CNT"))=R1I_U_$P(^TMP("R1FHQUE",$J,R1I,R1II),U,2)
         ..W !?3,$J(R1("CNT"),2),". ",R1I W:R1II'="NULL" ?20,R1II
         ..W ?35,$P(^TMP("R1FHQUE",$J,R1I,R1II),U)
UEDIT1   R !,"Your choice: ",R1("OPT"):DTIME I U[R1("OPT") D K Q
         I R1("OPT")'?1.2N!('$D(R1("SEL",R1("OPT")))) W "  ??" G UEDIT1
UEDIT2   R !!,"Time to run the option (use 4 digit military time): ",R1("TIME"):DTIME I U[R1("TIME") D K Q
         I R1("TIME")'?4N!(R1("TIME")>2359)!($E(R1("TIME"),3)>5) W "  ??" G UEDIT2
         S R1("NAME")=$P(R1("SEL",R1("OPT")),U)_" "_R1("TIME")
         S R1("DA")=$P(R1("SEL",R1("OPT")),U,2)
         S (DIC,DIE)="^R1(100100.024,",DIC(0)="M",X=R1("NAME") D ^DIC S DA=+Y
         I Y=-1 D  G UEDIT:%'=1
         .W !!,"Add entry ",$C(34),R1("NAME"),$C(34) S %=1 D YN^DICN Q:%'=1
         .S DIC(0)="L" K DD,DO D FILE^DICN
         .S DA=+Y,DR="1///"_$P(R1("NAME")," ",2),R1("ADDED")=""
         .D ^DIE W !,"Entry added."
         W !!,"Now add/change the printer and whether it's active.",!
         S DR="3///"_$$GET1^DIQ(100100.0243,R1("DA"),3)_";4///"_$$GET1^DIQ(100100.0243,R1("DA"),4)_";2R;5R//YES;20"
         D ^DIE S ^R1(100100.024,DA,1,0)="^100100.0242^",X=DA
         K DA,DIC,DIE,DR S DIC="^R1(100100.024,"_X_",1,",DIC(0)="L",DA(1)=X,R1("BAD")=0
         F R1I=0:0 S R1I=$O(^R1(100100.0243,R1("DA"),1,R1I)) Q:'R1I!(R1("BAD"))  D
         .S X=$$GET1^DIQ(100100.024302,R1I_","_R1("DA"),.01),DIC("DR")=""
         .D:$$GET1^DIQ(100100.024302,R1I_","_R1("DA"),1)="YES" ASK Q:R1("BAD")
         .K DIC("DR"),DD,DO D FILE^DICN S DA=+Y
         .S DR="",DIE=DIC D DR,^DIE K R1("QUES")
         .S:DR["3//" ^R1(100100.024,DA(1),1,DA,1)=$TR(^R1(100100.024,DA(1),1,DA,1),"|",U)
         I 'R1("BAD") W !!,"Option ",$S($D(R1("ADDED")):"add",1:"chang"),"ed!" H 3
         I R1("BAD") S DIK="^R1(100100.024," D ^DIK W !!,"Invalid entry - deleted!"
         K R1("ADDED") G UEDIT
         ;
ASK      N %DT,R1II,R1WP,X,Y S R1WP=$$GET1^DIQ(100100.024302,R1I_","_R1("DA"),5,"","R1WP")
         W !!,"Now answer this question:"
         F R1II=0:0 S R1II=$O(R1WP(R1II)) Q:'R1II  W !?3,R1WP(R1II)
         R !,"Your answer: ",X:DTIME I U[X S R1("BAD")=1 Q
         I $$GET1^DIQ(100100.024302,R1I_","_R1("DA"),3)="YES" S %DT="ET" D ^%DT I Y<1 W !,"Invalid date/time!" G ASK
         S R1("QUES")=X Q
         ;
DR       N X S DR=""
         F R1FD=1,2,3 D
         .I $G(R1("QUES"))]"",R1FD=1 S X=R1("QUES")
         .E  S X=$$GET1^DIQ(100100.024302,R1I_","_R1("DA"),R1FD+1) Q:X=""
         .S DR=DR_R1FD_"///"_X_";"
         Q
 